home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / unitxrf.com / PATHID.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-05-20  |  3.2 KB  |  113 lines
  1. {****************************************************************************}
  2. {*                                                                          *}
  3. {*    UNIT PATHID    (PATHID.PAS)                                           *}
  4. {*                                                                          *}
  5. {*    Donated to the Public Domain 5/20/91 by Dan Thomas CIS: 72301,2164    *}
  6. {*                                                                          *}
  7. {*  This unit contains two routines:                                        *}
  8. {*                                                                          *}
  9. {*    Split out the path from a file spec.                                  *}
  10. {*    Combine a path and file ID.                                           *}
  11. {*                                                                          *}
  12. {****************************************************************************}
  13.  
  14.  
  15. UNIT PATHID;
  16.  
  17.  
  18. {============================================================================}
  19. INTERFACE
  20.  
  21. CONST
  22.   ok_to_default = true;
  23.   dont_default  = false;
  24.  
  25. PROCEDURE SPLIT_PATH_AND_FILE_ID(file_spec                 : string;
  26.                                  var path, file_id         : string;
  27.                                  default_to_curr_directory : boolean);
  28. FUNCTION PATH_PLUS_FILE_ID(path, file_id : string) : string;
  29.  
  30. {============================================================================}
  31. IMPLEMENTATION
  32.  
  33. PROCEDURE SPLIT_PATH_AND_FILE_ID(file_spec                 : string;
  34.                                  var path, file_id         : string;
  35.                                  default_to_curr_directory : boolean);
  36.  
  37. var
  38.   d,s,p,c : string;
  39.   x       : byte;
  40.  
  41. begin
  42.   s := file_spec;
  43.   for x := 1 to length(s) do
  44.     s[x] := upcase(s[x]);
  45.   if (length(s) > 2) and (s[2] = ':') then
  46.     begin
  47.       d := copy(s,1,2);
  48.       delete(s,1,2);
  49.     end
  50.   else
  51.     d := '';
  52.   x := pos('\',s);
  53.   if x > 0 then
  54.     begin
  55.       x := length(s);
  56.       while (x > 1) and (s[x] <> '\') do
  57.         dec(x);
  58.       if x = 1 then
  59.         p := '\'
  60.       else
  61.         p := copy(s,1,x-1);
  62.       delete(s,1,x);
  63.     end
  64.   else
  65.     p := '';
  66.   if ((p = '') or (p[1] <> '\')) and default_to_curr_directory then
  67.     begin
  68.       if d = '' then
  69.         GetDir(0,c)
  70.       else
  71.         GetDir(ord(d[1]) - 64,c);
  72.       d := copy(c,1,2);
  73.       if p = '' then
  74.         p := copy(c,3,length(c))
  75.       else
  76.         p := copy(c,3,length(c)) + '\' + p;
  77.       if copy(p,1,2) = '\\' then
  78.         delete(p,1,1);
  79.     end;
  80.   path := d + p;
  81.   file_id := s;
  82. end; {split_path_and_id}
  83.  
  84. FUNCTION PATH_PLUS_FILE_ID(path, file_id : string) : string;
  85.  
  86. var
  87.   d,s : string;
  88.   x : byte;
  89.  
  90. begin
  91.   s := path;
  92.   if (length(s) > 1) and (s[2] = ':') then
  93.     begin
  94.       d := copy(s,1,2);
  95.       delete(s,1,2);
  96.     end
  97.   else
  98.     d := '';
  99.   while (s <> '') and (s[length(s)] = ' ') do
  100.     delete(s,length(s),1);
  101.   if (s = '\') or (s = '') then
  102.     begin end
  103.   else
  104.   if s[length(s)] <> '\' then
  105.     s := s + '\';
  106.   s := d + s + file_id;
  107.   for x := 1 to length(s) do
  108.     s[x] := upcase(s[x]);
  109.   path_plus_file_id := s;
  110. end; {path_plus_file_id}
  111.  
  112. end.
  113.